home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / Debian / DocBase / Document.pm < prev    next >
Encoding:
Perl POD Document  |  2008-11-11  |  12.5 KB  |  450 lines
  1. # vim:cindent:ts=2:sw=2:et:fdm=marker:cms=\ #\ %s
  2. #
  3. # $Id: Document.pm 154 2008-11-11 10:14:45Z robert $
  4. #
  5.  
  6. package Debian::DocBase::Document;
  7.  
  8. use strict;
  9. use warnings;
  10.  
  11. use Debian::DocBase::Common;
  12. use Debian::DocBase::Utils;
  13. use Debian::DocBase::DocBaseFile;
  14. use Debian::DocBase::DB;
  15. use Carp;
  16. #use Scalar::Util qw(weaken);
  17.  
  18. our %DOCUMENTS = ();
  19. my %section_map = ();
  20.  
  21. #################################################
  22. ###        PUBLIC STATIC FUNCTIONS            ###
  23. #################################################
  24.  
  25. # return list of all proceseed documents
  26. sub GetDocumentList() { # {{{
  27.   return values %DOCUMENTS;
  28. } # }}}
  29.  
  30. # check if $docid exists in status database
  31. sub IsRegistered($) { # {{{
  32.   my $docid = shift;
  33.   return Debian::DocBase::DB::GetStatusDB()->Exists($docid);
  34. } # }}}
  35.  
  36. # return all documents id from status database
  37. sub GetAllRegisteredDocumentIDs() { # {{{
  38.   my $db    = Debian::DocBase::DB::GetStatusDB()->GetDB();
  39.   my @result = sort keys %$db;
  40.   return @result;
  41. } # }}}
  42.  
  43. sub new { # {{{
  44.     my $class      = shift;
  45.     my $documentId = shift;
  46.     return $DOCUMENTS{$documentId} if defined  $DOCUMENTS{$documentId};
  47.  
  48.     my $self = {
  49.         DOCUMENT_ID       => $documentId,
  50.         MAIN_DATA         => {},
  51.         FORMAT_LIST       => {},
  52.         CONTROL_FILES     => {},
  53.         STATUS_DICT       => {},
  54.         MERGED_CTRL_FILES => 0,
  55.         INVALID           => 1
  56.     };
  57.     bless($self, $class);
  58.     $self->_ReadStatusDB($documentId);
  59.     $DOCUMENTS{$documentId} = $self;
  60. #  weaken $DOCUMENTS{$documentId};
  61.     return $self;
  62. } # }}}
  63.  
  64. #################################################
  65. ###            PUBLIC FUNCTIONS               ###
  66. #################################################
  67.  
  68. sub DESTROY { # {{{
  69.   my $self = shift;
  70.   delete $DOCUMENTS{$self->GetDocumentID()};
  71. } # }}}
  72.  
  73. sub GetDocumentID() { # {{{
  74.   my $self = shift;
  75.   return $self->{'DOCUMENT_ID'};
  76. } # }}}
  77.  
  78. sub Invalid() { # {{{
  79.   my $self = shift;
  80.   return $self->{'INVALID'};
  81. } # }}}
  82.  
  83.  
  84. # getters for common fields
  85. sub GetAbstract() { # {{{
  86.   my $self = shift;
  87.   return $self->_GetMainFld($FLD_ABSTRACT);
  88. } # }}}
  89.  
  90. sub GetTitle() { # {{{
  91.   my $self = shift;
  92.   return $self->_GetMainFld($FLD_TITLE);
  93. } # }}}
  94.  
  95. sub GetSection() { # {{{
  96.   my $self = shift;
  97.   return $self->_GetMainFld($FLD_SECTION);
  98. } # }}}
  99.  
  100. sub GetAuthor() { # {{{
  101.   my $self = shift;
  102.   return $self->_GetMainFld($FLD_AUTHOR);
  103. }   # }}}
  104.  
  105. # returns hash with format data (i.e. with FLD_FORMAT, $FLD_INDEX, $FLD_FILES keys)
  106. # for $format_name
  107. sub GetFormat($$) { # {{{
  108.   my $self = shift;
  109.   my $format_name = shift;
  110.   return undef unless $self->_HasControlFiles();
  111.   $self->_CheckMerged();
  112.   return $self->{'FORMAT_LIST'}->{$format_name};
  113. } # }}}
  114.  
  115. # returns status data for $key
  116. sub GetStatus() { # {{{
  117.   my $self = shift;
  118.   my $key  = shift;
  119.   return $self->{'STATUS_DICT'}->{$key};
  120. }   # }}}
  121.  
  122. sub SetStatus($%) { # {{{
  123.   my $self      = shift;
  124.   my %status    = @_;
  125.  
  126.   my $changed = 0;
  127.  
  128.   foreach my $key (keys %status) {
  129.     my $oldvalue = $self->{'STATUS_DICT'}->{$key};
  130.     my $value   = $status{$key};
  131.  
  132.     if (defined $value) {
  133.       $self->{'STATUS_DICT'}->{$key} = $value;
  134.     } else {
  135.        delete $self->{'STATUS_DICT'}->{$key};
  136.     }
  137.  
  138.     $changed = 1 if ( (defined $value xor defined $oldvalue)
  139.                    or (defined $value and $value ne $oldvalue) );
  140.   }
  141.  
  142.   $changed ? $self->_WriteStatusDB()
  143.            : Debug("Status of `" . join ("', `", keys %status) . "' in " .
  144.                     $self->GetDocumentID() . " not changed");
  145. }   # }}}
  146.  
  147. # displays informations about the document (called by `install-docs -s')
  148. sub DisplayStatusInformation($) { # {{{
  149.   my $self            = shift;
  150.   my $docid           = $self->GetDocumentID();
  151.   my $status_file     = "$DATA_DIR/$docid.status";
  152.   my $var_ctrl_file   = "$VAR_CTRL_DIR/$docid";
  153.  
  154.   if (-f $var_ctrl_file) {
  155.     if (open(F, '<', $var_ctrl_file)) {
  156.       print "---document-information---\n";
  157.       while (<F>) {
  158.         next if /^Control-Files:/;
  159.         s/^$/\n---format-description---/;
  160.         print $_;
  161.       }
  162.       close(F);
  163.     } else {
  164.       Warn("Cannot open `$var_ctrl_file': $!");
  165.     }
  166.   }
  167.  
  168.   print "\n---status-information---\n";
  169.   foreach my $cf (sort keys %{$self->{'CONTROL_FILES'}} ) {
  170.     print "Control-File: $cf (changed: ". localtime ($self->{'CONTROL_FILES'}->{$cf}->GetLastChangeTime()) . ")\n";
  171.   }
  172.  
  173.   foreach my $key (sort keys %{$self->{'STATUS_DICT'}} ) {
  174.     print "$key: $self->{'STATUS_DICT'}->{$key}\n";
  175.   }
  176. } # }}}
  177.  
  178. sub Register($$) { # {{{
  179.   my $self          = shift;
  180.   my $db_file       = shift;
  181.   my $db_filename   = $db_file->GetSourceFileName();
  182.  
  183.   Debug("Registering `$db_filename'");
  184.  
  185.   if ($db_file->GetDocumentID() ne $self->GetDocumentID()) {
  186.     delete $self->{'CONTROL_FILES'}->{$db_filename};
  187.     $db_file->OnRegistered(0);
  188.     return Error("Document id in `$db_filename' does not match our document id (" .
  189.                   $db_file->GetDocumentID() . ' != ' . $self->GetDocumentID() . ")");
  190.   }
  191.  
  192.   if ($db_file->Invalid()) {
  193.     delete $self->{'CONTROL_FILES'}->{$db_filename};
  194.     $db_file->OnRegistered(0);
  195.     return Warn($db_file->GetSourceFileName() . " contains errors, not registering");
  196.   }
  197.  
  198.   $db_file->OnRegistered(1);
  199.   $self->{'CONTROL_FILES'}->{$db_filename} = $db_file;
  200. } # }}}
  201.  
  202. sub Unregister($$) { # {{{
  203.   my $self          = shift;
  204.   my $db_file       = shift;
  205.   my $db_filename   = $db_file->GetSourceFileName();
  206.  
  207.   unless (exists $self->{'CONTROL_FILES'}->{$db_filename}) {
  208.     # remove any file data from our existing files database if it's there
  209.     Debian::DocBase::DB::GetFilesDB()->RemoveData($db_filename);
  210.     return Warn( "File `" . $db_filename . "' is not registered, cannot remove");
  211.   }
  212.  
  213.   $self->{'CONTROL_FILES'}->{$db_filename}->OnUnregistered();
  214.   delete $self->{'CONTROL_FILES'}->{$db_filename};
  215.  
  216. } # }}}
  217.  
  218. sub UnregisterAll($) { # {{{
  219.   my $self          = shift;
  220.  
  221.   Debug('Unregistering all control files from document `' . $self->GetDocumentID() . "'");
  222.  
  223.   foreach my $doc ( values %{$self->{'CONTROL_FILES'}} ) {
  224.     $doc->OnUnregistered();
  225.   }
  226.  
  227.  
  228.   $self->{'CONTROL_FILES'} = {};
  229. } # }}}
  230.  
  231. # generate and write new merged control file into /var/lib/doc-base/documents
  232. sub WriteNewCtrlFile() { # {{{
  233.   my $self     = shift;
  234.   my $docid    = $self->GetDocumentID();
  235.   my $tmpfile  = $VAR_CTRL_DIR . "/." . $docid . ".tmp";
  236.   my $file     = $VAR_CTRL_DIR . "/" . $docid;
  237.   my $fld      = undef;
  238.  
  239.   $self->_CheckMerged();
  240.  
  241.   if ($self->Invalid() || !$self->_HasControlFiles()) {
  242.     if (-e $file)  {
  243.       Debug("Removing control file $file");
  244.       unlink $file or carp "Can't remove $file: $!";
  245.     }
  246.     return;
  247.   }
  248.  
  249.  
  250.   open(F, '>', $tmpfile) or
  251.     carp ("Can't open $tmpfile for writing: $_");
  252.  
  253.   foreach $fld (GetFldKeys($FLDTYPE_MAIN)) {
  254.     print F ucfirst($fld) . ": " .  $self->{'MAIN_DATA'}->{$fld} . "\n"
  255.       if $self->{'MAIN_DATA'}->{$fld};
  256.   }
  257.  
  258.   foreach my $format (sort keys %{$self->{'FORMAT_LIST'}}) {
  259.     print F "\n";
  260.     foreach $fld (GetFldKeys($FLDTYPE_FORMAT)) {
  261.       print F ucfirst($fld) . ": " .  $self->{'FORMAT_LIST'}->{$format}->{$fld} . "\n"
  262.         if $self->{'FORMAT_LIST'}->{$format}->{$fld};
  263.     }
  264.   }
  265.  
  266.   close F or carp "Can't close $file: $!";
  267.  
  268.   rename $tmpfile, $file or carp "Can't rename $tmpfile to $file: $!";
  269. } # }}}
  270.  
  271. # merge contents of all available control files for the document
  272. #  into $self->{'MAIN_DATA'} and $self->{'FORMAT_LIST'}
  273. # Fields 'Document' and 'Section' must have the same value in all control files.
  274. # Value of fields 'Author', 'Abstract', 'Title' is taken from the first control file
  275. #  in which the value is not empty.
  276. # Format sections are joined. It's an error if the same format is defined in more
  277. #  than one control file.
  278. sub MergeCtrlFiles($) { # {{{
  279.   my $self    = shift;
  280.   my $doc_id  = $self->GetDocumentID();
  281.  
  282.   $self->_ParseControlFiles();
  283.  
  284.   $self->{'INVALID'}           = 1;
  285.   $self->{'MERGED_CTRL_FILES'} = 1;
  286.   $self->{'MAIN_DATA'}         = {};
  287.   $self->{'FORMAT_LIST'}       = {};
  288.  
  289.   foreach my $db_file_name ($self->_GetControlFileNames()) {
  290.     my $doc_data  = $self->{'CONTROL_FILES'}->{$db_file_name};
  291.     my $doc_fname = $doc_data->GetSourceFileName();
  292.  
  293.     if ($doc_data->GetDocumentID() ne $doc_id) {
  294.       Warn("Document id in `" . $doc_fname ."' does not match our document id (" .
  295.                   $doc_data->GetDocumentID()  . ' != ' . $self->GetDocumentID() . ")");
  296.       $self->Unregister($doc_data);
  297.       next;
  298.     }
  299.  
  300.     # merge main sections' fields
  301.     foreach my $fld (GetFldKeys($FLDTYPE_MAIN)) {
  302.       my $old_val = $self->{'MAIN_DATA'}->{$fld};
  303.       my $new_val = $doc_data->GetFldValue($fld);
  304.       if ($new_val) {
  305.         $new_val = $self->_MangleSection($new_val) if $fld eq $FLD_SECTION;
  306.  
  307.         if ($old_val and $old_val ne $new_val and
  308.             ($fld eq $FLD_DOCUMENT or $fld eq $FLD_SECTION)) {
  309.             return Error("Error while merging $doc_id with $doc_fname: inconsistent values of $fld");
  310.         }
  311.         $self->{'MAIN_DATA'}->{$fld} = $new_val unless $old_val;
  312.       }
  313.     }
  314.  
  315.     # merge formats
  316.     foreach my $format ($doc_data->GetFormatNames()) {
  317.       return Error("Error while merging $doc_id with $doc_fname: format $format already defined") if $self->{'FORMAT_LIST'}->{$format};
  318.       $self->{'FORMAT_LIST'}->{$format} = $doc_data->GetFormat($format);
  319.     }
  320.   }
  321.   return unless  %{$self->{'FORMAT_LIST'}};
  322.   $self->{'INVALID'}           = 0;
  323. } # }}}
  324.  
  325.  
  326. # Save status changes, calls _WriteStatusDB()
  327. sub SaveStatusChanges($) { # {{{
  328.   my $self = shift;
  329.  
  330.   $self->_WriteStatusDB();
  331. } # }}}
  332.  
  333. #################################################
  334. ###            PRIVATE FUNCTIONS              ###
  335. #################################################
  336.  
  337. # dies with Internal error if document hasn't been merged yet
  338. sub _CheckMerged($) { # {{{
  339.   my $self = shift;
  340.  
  341.   croak "Internal error: Document " . $self->GetDocumentID(). " not yet merged"
  342.     unless $self->{'MERGED_CTRL_FILES'};
  343. } # }}}
  344.  
  345. # returns $fld from $self->{'MAIN_DATA'}
  346. sub _GetMainFld($$) { # {{{
  347.   my $self = shift;
  348.   my $fld  = shift;
  349.  
  350.   $self->_CheckMerged();
  351.  
  352.   return "" if $self->Invalid();
  353.  
  354.   return "" unless $self->{'MAIN_DATA'}->{$fld};
  355.  
  356.   return $self->{'MAIN_DATA'}->{$fld};
  357. } # }}}
  358.  
  359. sub _HasControlFiles() { # {{{
  360.   my $self = shift;
  361.   return $self->{'CONTROL_FILES'}
  362. } # }}}
  363.  
  364. # reads our status file and sets $self->{'STATUS_DICT'} and sets keys of
  365. # $self->{'CONTROL_FILES'}
  366. sub _ReadStatusDB { # {{{
  367.   my $self        = shift;
  368.   my $docid       = $self->GetDocumentID();
  369.   my $data        = Debian::DocBase::DB::GetStatusDB()->GetData($docid);
  370.  
  371.   if ($data) {
  372.     my %cf = map { $_ => Debian::DocBase::DocBaseFile->new($_) } keys %{$data->{'CF'}};
  373.     $self->{'CONTROL_FILES'}  = \%cf;
  374.     $self->{'STATUS_DICT'}    = $data->{'SD'};
  375.   } else {
  376.     $self->{'CONTROL_FILES'} = {};
  377.     $self->{'STATUS_DICT'}   = {};
  378.   };
  379.   $self->{'INVALID'} = 0;
  380.  
  381. } # }}}
  382.  
  383. # writes our status file
  384. sub _WriteStatusDB { # {{{
  385.   my $self  = shift;
  386.   my $docid = $self->GetDocumentID();
  387.  
  388.   if (%{$self->{'CONTROL_FILES'}} or %{$self->{'STATUS_DICT'}}) {
  389.     my %cf = map { $_ => undef }  keys %{$self->{'CONTROL_FILES'}};
  390.  
  391.     my $data = { 'CF' => \%cf,
  392.                  'SD' => $self->{'STATUS_DICT'}
  393.                };
  394.    Debian::DocBase::DB::GetStatusDB()->PutData($docid, $data);
  395.   } else {
  396.    Debian::DocBase::DB::GetStatusDB()->RemoveData($docid);
  397.   }
  398. } # }}}
  399.  
  400. # if called without any argument, returns array of control files' names
  401. # if called with an argument returns string containing names of the control files
  402. #  joined with value of the argument
  403. sub _GetControlFileNames($;$) { # {{{
  404.   my $self      = shift;
  405.   my $join_str  = shift;
  406.  
  407.   my @cfnames = sort keys %{$self->{'CONTROL_FILES'}};
  408.  
  409.   return @cfnames unless ($join_str);
  410.   return join($join_str, @cfnames);
  411. } # }}}
  412.  
  413. # reads and parses all control files mentioned in $self->{'CONTROL_FILES'}
  414. sub _ParseControlFiles($) { # {{{
  415.   my $self = shift;
  416.  
  417.   foreach my $cfname ($self->_GetControlFileNames()) {
  418.     croak "Internal error: $cfname not created\n" unless $self->{'CONTROL_FILES'}->{$cfname};
  419.     $self->{'CONTROL_FILES'}->{$cfname}->Parse();
  420.   }
  421. } # }}}
  422.  
  423. sub _MangleSection($) { # {{{
  424.   my $self      = shift;
  425.   my $section   = shift;
  426.  
  427.   ReadMap($DOCBASE_SECTIONS_MAP, \%section_map) unless %section_map;
  428.  
  429.   $section  = lc $section;
  430.   $section  =~ s/\s+/ /g;       $section  =~ s/\/+/\//g;
  431.   $section  =~ s/[\/\s]$//g;    $section  =~ s/^[\/\s]//g;
  432.   $section  =~ s/\b./\U$&\E/g;
  433.  
  434.   my @sect_comps = split (/\/+/, $section);
  435.   my $result     = "";
  436.  
  437.   while ($#sect_comps > -1) {
  438.     my $tmp   =  shift(@sect_comps);
  439.     $result   =  ($result) ? $result . "/" .  $tmp : $tmp;
  440.  
  441.     $tmp      = lc $result;
  442.     $result   = $section_map{$tmp} if exists $section_map{$tmp};
  443.   }
  444.  
  445.   return $result if $result;
  446.   return "Unknown";
  447. } # }}}
  448.  
  449. 1;
  450.